BrightonSchoolSIM

Author

Adam Dennett

library(tidyverse)
Warning: package 'tidyverse' was built under R version 4.3.3
Warning: package 'ggplot2' was built under R version 4.3.3
Warning: package 'tidyr' was built under R version 4.3.3
Warning: package 'readr' was built under R version 4.3.3
Warning: package 'dplyr' was built under R version 4.3.3
Warning: package 'stringr' was built under R version 4.3.3
── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.5.1     ✔ tibble    3.2.1
✔ lubridate 1.9.3     ✔ tidyr     1.3.1
✔ purrr     1.0.2     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(sf)
Warning: package 'sf' was built under R version 4.3.3
Linking to GEOS 3.11.2, GDAL 3.8.2, PROJ 9.3.1; sf_use_s2() is TRUE
library(janitor)

Attaching package: 'janitor'

The following objects are masked from 'package:stats':

    chisq.test, fisher.test
library(here)
here() starts at E:/BH_Schools_2
library(usethis)
Warning: package 'usethis' was built under R version 4.3.3
library(tmap)
Warning: package 'tmap' was built under R version 4.3.3
Breaking News: tmap 3.x is retiring. Please test v4, e.g. with
remotes::install_github('r-tmap/tmap')
library(readxl)
library(r5r)
Warning: package 'r5r' was built under R version 4.3.3
Please make sure you have already allocated some memory to Java by running:
  options(java.parameters = '-Xmx2G').
You should replace '2G' by the amount of memory you'll require. Currently, Java memory is set to 
library(dplyr)
library(tidyr)

Spatial Interaction Demand Model for Brighton Schools

Origins - Brighton LSOAs and Pupils in 2024

Reading layer `BrightonLSOA_Clean' from data source 
  `E:\BH_Schools_2\data\BrightonLSOA_Clean.geojson' using driver `GeoJSON'
Simple feature collection with 165 features and 27 fields
Geometry type: MULTIPOLYGON
Dimension:     XY
Bounding box:  xmin: -0.2450499 ymin: 50.79908 xmax: -0.0160027 ymax: 50.89237
Geodetic CRS:  WGS 84
Reading layer `lsoa_btn_pw_cent' from data source 
  `E:\BH_Schools_2\data\lsoa_btn_pw_cent.geojson' using driver `GeoJSON'
Simple feature collection with 165 features and 1 field
Geometry type: POINT
Dimension:     XY
Bounding box:  xmin: 524624.9 ymin: 102198.2 xmax: 538674.1 ymax: 109563.7
Projected CRS: OSGB36 / British National Grid
Reading layer `LSOA_NOMIS_plus_projections' from data source 
  `E:\BH_Schools_2\data\LSOA_NOMIS_plus_projections.geojson' 
  using driver `GeoJSON'
replacing null geometries with empty geometries
Simple feature collection with 3465 features and 5 fields (with 3465 geometries empty)
Geometry type: GEOMETRYCOLLECTION
Dimension:     XY
Bounding box:  xmin: NA ymin: NA xmax: NA ymax: NA
Geodetic CRS:  WGS 84
Reading layer `BrightonSecondaryCatchments' from data source 
  `E:\BH_Schools_2\data\BrightonSecondaryCatchments.geojson' 
  using driver `GeoJSON'
Simple feature collection with 6 features and 2 fields
Geometry type: MULTIPOLYGON
Dimension:     XY
Bounding box:  xmin: 523887.8 ymin: 100896.4 xmax: 539613.4 ymax: 110190.1
Projected CRS: OSGB36 / British National Grid
Reading layer `optionA' from data source `E:\BH_Schools_2\data\optionA.geojson' using driver `GeoJSON'
Simple feature collection with 6 features and 2 fields
Geometry type: MULTIPOLYGON
Dimension:     XY
Bounding box:  xmin: 523889.3 ymin: 100892.8 xmax: 540295.5 ymax: 110191.6
Projected CRS: OSGB36 / British National Grid
Reading layer `optionB' from data source `E:\BH_Schools_2\data\optionB.geojson' using driver `GeoJSON'
Simple feature collection with 4 features and 2 fields
Geometry type: MULTIPOLYGON
Dimension:     XY
Bounding box:  xmin: 523890.5 ymin: 100894.1 xmax: 539613.1 ymax: 110186.1
Projected CRS: OSGB36 / British National Grid

Destinations - Brighton Secondary Schools

# Create the tmap
tmap_mode("view")
tmap mode set to interactive viewing
tm_shape(BrightonLSOA_pw_cent) +
  tm_dots(size = "2024", col = "2024", alpha = 0.5, border.alpha = 0, title = "Total Children") +
  tm_layout(legend.show = TRUE, title = "11 year olds, 2024") +
tm_shape(bh_catchments) +
  tm_borders() +
  tm_fill(alpha = 0) +
tm_shape(brighton_sec_schools_sml) +
  tm_dots()
Warning: The shape bh_catchments is invalid (after reprojection). See
sf::st_is_valid
Legend for symbol sizes not available in view mode.

Interactions

[1] "21"
Reading layer `oa_brighton' from data source 
  `E:\BH_Schools_2\data\oa_brighton.geojson' using driver `GeoJSON'
Simple feature collection with 936 features and 10 fields
Geometry type: MULTIPOLYGON
Dimension:     XY
Bounding box:  xmin: 523598.1 ymin: 101780.1 xmax: 539862.4 ymax: 111919.1
Projected CRS: OSGB36 / British National Grid

Note, I mess something up down here, so use the code from additional_supporting_info

#set up the destinations for R5R
bh_sec_sch1 <- brighton_sec_schools %>% 
  select(urn, establishment_name, geometry) %>%
  rename(id = urn) %>% 
  st_transform(4326)

coords <- st_coordinates(bh_sec_sch1)
bh_sec_sch1$lon <- coords[, 1]
bh_sec_sch1$lat <- coords[, 2]

#now set up the origins
BrightonLSOA_pw_cent <- BrightonLSOA_pw_cent %>%
  mutate(fid = row_number())
BrightonLSOA_pw_cent <- BrightonLSOA_pw_cent %>% 
  st_transform(4326)
coords <- st_coordinates(BrightonLSOA_pw_cent)
BrightonLSOA_pw_cent$lon <- coords[, 1]
BrightonLSOA_pw_cent$lat <- coords[, 2]


names(BrightonLSOA_pw_cent)
[1] "lsoa21cd" "geometry" "2024"     "fid"      "lon"      "lat"     
brighton_lsoa_points_r51 <- BrightonLSOA_pw_cent %>% 
  select(fid, lsoa21cd ,lat, lon) %>% 
  rename(lon = lon, lat = lat, id = fid) %>% 
  st_transform(4326) %>% 
  st_set_crs(4326)
#travel time matrix

# Set parameters
mode = c("WALK", "BUS")
max_walk_time = 360 # minutes
max_trip_duration = 520 # minutes
departure_datetime = as.POSIXct("23-05-2024 8:30:00",
                                 format = "%d-%m-%Y %H:%M:%S", 
                                tz = "GMT")

#note the code below already requires the h3 core matrix to be set up

# Calculate the travel time matrix by Transit
ttm_btn_lsoa_to_School = travel_time_matrix(r5r_core = r5r_core,
                          origins = bh_sec_sch1,
                          destinations = brighton_lsoa_points_r51,
                          mode = mode,
                          departure_datetime = departure_datetime,
                          max_walk_time = max_walk_time,
                          max_trip_duration = max_trip_duration)
Warning in assign_points_input(origins, "origins"): 'origins$id' forcefully
cast to character.
Warning in assign_points_input(destinations, "destinations"): 'destinations$id'
forcefully cast to character.
nrow(bh_sec_sch1) * nrow(brighton_lsoa_points_r51)
[1] 1650
ttm_btn_lsoa_to_School[, to_id:=as.numeric(to_id)]

#join codes back to the matrix and get it ready from plotting
ttm_btn_lsoa_to_School$orig_lsoa <- brighton_lsoa_points_r51$lsoa21cd[match(ttm_btn_lsoa_to_School$to_id, brighton_lsoa_points_r51$id)]

ttm_btn_lsoa_to_School$dest_sch <- bh_sec_sch1$establishment_name[match(ttm_btn_lsoa_to_School$from_id, bh_sec_sch1$id)]

#origs and dests all messed up
ttm_btn_lsoa_to_School <- ttm_btn_lsoa_to_School %>%
  mutate(to_id = as.factor(to_id)) %>%
  unite(od_code, orig_lsoa, from_id, sep = "_", remove = FALSE)

simple_ttm <- ttm_btn_lsoa_to_School %>%
  select(orig_lsoa, from_id, travel_time_p50) %>% 
  rename(orig = orig_lsoa, dest = from_id, flow = travel_time_p50)

class(ttm_btn_lsoa_to_School)
[1] "data.frame"
simple_ttm <- na.omit(simple_ttm) %>% 
  unite("od_code", c("orig","dest"), sep = "_", remove = FALSE)

Cost - Travel Time Along the Road Network

library(stplanr)
Warning: package 'stplanr' was built under R version 4.3.3
library(od)
Warning: package 'od' was built under R version 4.3.3

Attaching package: 'od'
The following objects are masked from 'package:stplanr':

    od_id_character, od_id_max_min, od_id_order, od_id_szudzik,
    od_oneway, od_to_odmatrix, odmatrix_to_od
library(tmap)

# Switch to view mode
tmap_mode("view")
tmap mode set to interactive viewing
# Set options
tmap_options(check.and.fix = TRUE)

# Create the map with the two sf objects
tm_shape(brighton_lsoa_points_r51) +
tm_dots() +  
tm_shape(bh_sec_sch1) + 
tm_dots(col = "red") +  
  tm_layout(
    legend.title.size = 1,          # Adjust the size of the legend title
    legend.outside.size = 0.15,     # Adjust the position of the legend
    title = "Your Custom Title"     # Set your custom legend title
)
#nrow(brighton_lsoa_points_r51) * nrow(bh_sec_sch1)
brighton_lsoa_points_r52 <- brighton_lsoa_points_r51 %>% 
  select(c("lsoa21cd", "lat", "lon", "geometry")) %>% 
  rename(orig = lsoa21cd)

bh_sec_sch2 <- bh_sec_sch1 %>%
  rename(dest = id)

simple_ttm2 <- simple_ttm %>% 
  select(orig, dest, flow) %>% 
  rename(orig = orig, dest = dest, flow = flow)

##big matrix for the whole of Brighton - won't need this now. 
lsoa_btn_to_school_matrix <- 
  matrix(0, nrow = nrow(brighton_lsoa_points_r51), ncol = nrow(bh_sec_sch1), dimnames = list(brighton_lsoa_points_r51$lsoa21cd,bh_sec_sch1$id))

###############
#matrix to paired list
#all of London - and add an od_id
lsoa_btn_to_school_matrix_all <- odmatrix_to_od(lsoa_btn_to_school_matrix) %>% 
  unite("od_code", c("orig","dest"), sep = "_", remove = FALSE)

brighton_sch_Commute_lines <- od2line(flow = simple_ttm2, zones = brighton_lsoa_points_r52, destinations = bh_sec_sch2)

brighton_sch_Commute_lines1 <- od::od_to_sf(x = simple_ttm2, z = brighton_lsoa_points_r52, zd = bh_sec_sch2, crs = 4326)
0 origins with no match in zone ids
0 destinations with no match in zone ids
 points not in od data removed.
brighton_sch_Commute_longhill <- brighton_sch_Commute_lines %>% 
  filter(dest == 114581)

Map the flows

tmap_mode("view")
tmap mode set to interactive viewing
map <- tm_shape(brighton_sch_Commute_longhill) +
  tm_lines(palette = "plasma", breaks = c(15, 30, 45, 60, 75, 90, 105, 120),
           lwd = "flow",
           scale = 5,
           id="orig",
           popup.vars= c("flow"),
           title.lwd = "Travel Time, Bus or Walk",
           alpha = 0.5,
           col = "flow",
           title = "Travel Time, Bus or Walk")+
  tm_shape(bh_sec_sch2)+
          tm_dots(col="establishment_name", size=0.01,id="establishment_name", title = "establishment_name" , legend.show = F) +
  tm_shape(bh_catchments) +
          tm_polygons(col = NA, alpha = 0)

map
Warning: The shape bh_catchments is invalid (after reprojection). See
sf::st_is_valid
Warning: Values have found that are higher than the highest break
Legend for line widths not available in view mode.
brighton_sch_Commute <- brighton_sch_Commute_lines %>% 
  filter(dest == 114580)

tmap_mode("view")
tmap mode set to interactive viewing
# Create the map with thicker lines for smaller values
map <- tm_shape(brighton_sch_Commute) +
  tm_lines(palette = "plasma", breaks = c(15, 30, 45, 60, 75, 90, 105, 120),
           lwd = "flow",
           scale = 5,
           id="orig",
           popup.vars= c("flow"),
           title.lwd = "Travel Time, Bus or Walk",
           alpha = 0.5,
           col = "flow",
           title = "Travel Time, Bus or Walk")+
  tm_shape(bh_sec_sch2)+
          tm_dots(col="establishment_name", size=0.01,id="establishment_name", title = "establishment_name", legend.show = F) +
  tm_shape(bh_catchments) +
          tm_polygons(col = NA, alpha = 0)

map
Warning: The shape bh_catchments is invalid (after reprojection). See
sf::st_is_valid
Warning: Values have found that are less than the lowest break
Warning: Values have found that are higher than the highest break
Legend for line widths not available in view mode.